home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / thor / DMThor.lha / DMThor.thor < prev   
Text File  |  1996-12-02  |  8KB  |  303 lines
  1. /*
  2. **   Filename: DMThor.thor
  3. **
  4. **   $VER: v1.50 (12.02.96)
  5. **
  6. **   Author:  Troy E. Bouchard
  7. **
  8. **   Address: 737D Alyeska Ave.
  9. **          Kodiak, AK 99615
  10. **            USA
  11. **
  12. **   EMail:   tbouchar@ptialaska.net
  13. **   Webpage: http://www.ptialaska.net/~tbouchar
  14. **
  15. **   Desc:  This program will read in a conference name and copy all
  16. **        messages in that conference to a text file that you could
  17. **        then (possibly) use to create a digest and post to your
  18. **        webpage or to create a digest and post on a listserver.
  19. **        I believe that there is a Thor script that will read in
  20. **        a digest file and copy the messages to a conference of your
  21. **        choosing, I just don't remember what it's called (sorry).
  22. **        (sortmail?)
  23. **
  24. **   Requires:    Thor v2.1+ - Although this script was written with
  25. **        Thor v2.4  - it should work with versions 2.1 and up
  26. **        (not tested though)
  27. **
  28. */
  29.  
  30. options results
  31.  
  32. /* Find our Thor Port and number! */
  33. p = Address() || ' ' || show('P',,)
  34.     ThorPort = pos('THOR.',p)
  35.  
  36.     if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  37. else
  38.     do
  39.     say "Can't seem to find the Thor port!"
  40.     exit 10
  41.     End
  42.  
  43. /* Load the BBSRead library up! */
  44. if ~show('p', 'BBSREAD') then
  45. do
  46.     address command
  47.         "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  48.         "WaitForPort BBSREAD"
  49. End
  50.  
  51. SIGNAL ON SYNTAX
  52. SIGNAL ON HALT
  53.  
  54. MDF_DELETED = 5       /* Message is deleted      */
  55. MDF_UNRECOVERABLE = 6 /* Message is unrecoverable */
  56.  
  57. TB_MSGPATH = 'T:'
  58.  
  59. Call GetPages
  60. Call Done
  61.  
  62. GetPages:
  63.    Address BBSREAD
  64.    'GETBBSLIST stem "'BBSLIST'"'
  65.    if(rc ~=0) then
  66.    do
  67.       Address(ThorPort)
  68.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  69.       call cleanup
  70.    End
  71.  
  72.    Address(ThorPort)
  73.    'REQUESTLIST instem "'BBSLIST'" outstem "'TB_SYSTEM'" title "Selection:" DRAGSELECT MULTISELECT SIZEGADGET'
  74.    if(rc ~= 0) then exit
  75.    do i=1 to TB_SYSTEM.COUNT
  76.       Address BBSREAD
  77.       'GETCONFLIST "'TB_SYSTEM.i'" CONFLIST'
  78.       if(rc ~= 0) then
  79.       do
  80.      Address(ThorPort)
  81.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  82.      call cleanup
  83.       End
  84.  
  85.       Address(ThorPort)
  86.       'REQUESTLIST instem "'CONFLIST'" title "Select conference on ' || TB_SYSTEM.i || ":" ||'" SIZEGADGET'
  87.       if(rc ~= 0) then TB_CONFNAME = ""
  88.       else TB_CONFNAME = result
  89.  
  90.       MyConf = Translate(TB_CONFNAME,," ","_")
  91.  
  92.       Address BBSREAD
  93.       'GETCONFDATA BBSName "'TB_SYSTEM.i'" ConfName "'TB_CONFNAME'" Stem CDATA'
  94.       if(rc ~= 0) then
  95.       do
  96.      Address(ThorPort)
  97.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  98.      call cleanup
  99.       End
  100.  
  101.      Call MessageHeader
  102.      Call TopicText
  103.  
  104.       Address(ThorPort)
  105.       'OPENPROGRESS TITLE " DMThor v1.50" PT "Getting Messages..." AT "_Abort" PCW 30'
  106.       if(rc ~= 0) then
  107.       do
  108.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  109.      call cleanup
  110.       end
  111.       else win = result
  112.  
  113.       msgnumber = 0
  114.  
  115.  
  116.       do j = CDATA.FIRSTMSG to CDATA.LASTMSG
  117.      Drop MsgData.
  118.      Drop HeaderInfo.
  119.      Drop TextInfo.
  120.  
  121.      Address BBSREAD
  122.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" DataStem "'MsgData'"'
  123.      if(rc ~= 0) then
  124.      do
  125.         Address(ThorPort)
  126.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  127.         call cleanup
  128.      end
  129.  
  130.      if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  131.      do
  132.         msgnumber = msgnumber + 1
  133.         Address(ThorPort)
  134.         msgtext = 'Saving Messages to: 'MyConf||'.digest'
  135.         'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnumber'" PT "'msgtext'"'
  136.         if(rc ~= 0) then do
  137.           call cleanup
  138.         end
  139.  
  140.         Address BBSREAD
  141.         'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
  142.         if(rc ~= 0) then
  143.         do
  144.            Address(ThorPort)
  145.            'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  146.            call Cleanup
  147.         end
  148.  
  149.         'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  150.         if(rc ~= 0) then
  151.         do
  152.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  153.         Say ''
  154.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  155.         Say NewTime
  156.         Say 'Delete Message nr: 'j' and try again'
  157.         call Cleanup
  158.         end
  159.  
  160.         if symbol('HeaderInfo.FROMADDR') = "VAR" then
  161.            Addr = value('HeaderInfo.FROMADDR')
  162.  
  163.         if symbol('HeaderInfo.FROMNAME') = "VAR" then
  164.            Nom = value('HeaderInfo.FROMNAME')
  165.  
  166.         if symbol('HeaderInfo.SUBJECT') = "VAR" then
  167.            Subj = value('HeaderInfo.SUBJECT')
  168.  
  169.         if symbol('HeaderInfo.TOADDR') = "VAR" then
  170.         ToAdd = value('HeaderInfo.TOADDR')
  171.  
  172.         Call MessageText
  173.      end
  174.       end
  175.    end
  176. Return
  177.  
  178. Done:
  179.    Address(ThorPort)
  180.    'REQUESTNOTIFY TEXT "    We Are Done!\nDigest Files Copied!" BT "_Cool!"'
  181.    Call Cleanup
  182.  
  183. MessageHeader:
  184.    Call Open out, TB_MSGPATH || MyConf || '.digest', w
  185.    Call WriteLN out, '                    '|| MyConf || ' Digest for 'Date()
  186.    Call WriteLN out, ' '
  187.    Call WriteLN out, 'Topics for Conference 'MyConf||':'
  188.    Call WriteLN out, ' '
  189.    Call Close out
  190. Return
  191.  
  192. TopicText:
  193.    Address(ThorPort)
  194.    'OPENPROGRESS TITLE " DMThor v1.50" PT "Getting Topics..." AT "_Abort" PCW 30'
  195.    if(rc ~= 0) then
  196.    do
  197.       'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  198.       call cleanup
  199.    end
  200.    else win = result
  201.  
  202.    msgnbr = 0
  203.  
  204.    do k = CDATA.FIRSTMSG to CDATA.LASTMSG
  205.       Drop HeaderInfo.
  206.       Drop MsgData.
  207.  
  208.       Address BBSREAD
  209.       'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'k'" DataStem "'MsgData'"'
  210.       if(rc ~= 0) then
  211.       do
  212.      Address(ThorPort)
  213.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  214.      call cleanup
  215.       end
  216.  
  217.       if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  218.       do
  219.      msgnbr = msgnbr + 1
  220.      Address(ThorPort)
  221.      msgtext = 'Saving Topics to: 'MyConf||'.digest'
  222.      'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnbr'" PT "'msgtext'"'
  223.      if(rc ~= 0) then do
  224.         call cleanup
  225.      end
  226.  
  227.      Address BBSREAD
  228.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'k'" HeadStem "'HeaderInfo'"'
  229.      if(rc ~= 0) then
  230.      do
  231.         Address(ThorPort)
  232.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  233.         call Cleanup
  234.      end
  235.  
  236.      'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  237.      if(rc ~= 0) then
  238.      do
  239.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  240.         Say ''
  241.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  242.         Say NewTime
  243.         Say 'Delete Message nr: 'k' and try again'
  244.         call Cleanup
  245.      end
  246.  
  247.      if symbol('HeaderInfo.FROMADDR') = "VAR" then
  248.         Addr = value('HeaderInfo.FROMADDR')
  249.  
  250.      if symbol('HeaderInfo.FROMNAME') = "VAR" then
  251.         Nom = value('HeaderInfo.FROMNAME')
  252.  
  253.      if symbol('HeaderInfo.SUBJECT') = "VAR" then
  254.         Subj = value('HeaderInfo.SUBJECT')
  255.  
  256.      Call Open out, TB_MSGPATH || MyConf || '.digest', a
  257.      Call WriteLN out, msgnbr'.  'Subj
  258.      Call WriteLN out, '          by 'Nom' ('Addr')'
  259.      Call WriteLN out, ' '
  260.      Call Close out
  261.       end
  262.    end
  263.  
  264.    if (win ~= 0) & Symbol('win') = 'VAR' then do
  265.       Address(ThorPort)
  266.       'CloseProgress REQ' win
  267.    end
  268. Return
  269.  
  270. MessageText:
  271.    Call Open out, TB_MSGPATH || MyConf || '.digest',a
  272.    Call WriteLN out, '---------------------------------------------------------------------------'
  273.    Call WriteLN out, '                              Message Nr. 'msgnumber'                              '
  274.    Call WriteLN out, '---------------------------------------------------------------------------'
  275.  
  276.    Call WriteLN out, 'From: 'Nom' ('Addr')'
  277.    Call WriteLN out, 'To: 'ToAdd
  278.    Call WriteLN out, 'Subject: 'Subj
  279.    Call WriteLN out, ' '
  280.  
  281.    cnt = value('TextInfo.TEXT.COUNT')
  282.  
  283.    if(cnt = 0) then call writeln(out,'No Text')
  284.       else
  285.       do
  286.      do n = 1 to cnt
  287.         call writeln(out, value('TextInfo.TEXT.n'))
  288.      end
  289.      Call Close out
  290.       end
  291.       Call Close out
  292. Return
  293.  
  294. SYNTAX:
  295.   SAY 'Error: 'rc' in line 'sigl': 'errortext(rc)
  296. HALT:
  297. cleanup:
  298.  IF (win ~= 0) & SYMBOL('win') = 'VAR' THEN DO
  299.    ADDRESS(ThorPort)
  300.    'CLOSEPROGRESS REQ' win
  301.  END
  302. EXIT
  303.